home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / apg_2.exe / PHONE1.S&M < prev    next >
Text File  |  1993-03-18  |  5KB  |  228 lines
  1. ''''''''''''''''''''''''''''''''''''''''''''''''''
  2. '                                                '
  3. '                Phone List by Name              '
  4. '                                                '
  5. '                 CREATED BY APG                 '
  6. '                 S & M SOFTWARE                 '
  7. '                 COPYRIGHT 1993                 '
  8. '                                                '
  9. '         USE files are PHONE.USE and .US1       '
  10. '                                                '
  11. '  Author: S&M Software                          '
  12. '  Date:   03-18-1993                            '
  13. '  Time:   10:44:54                              '
  14. '                                                '
  15. '  USE file Created         USE file Modified    '
  16. '  Date:   03-10-1993       Date:   03-14-1993   '
  17. '  Time:   22:50:08         Time:   11:18:01     '
  18. ''''''''''''''''''''''''''''''''''''''''''''''''''
  19.  
  20. DEFINT A-Z
  21. DECLARE SUB box ()
  22. DECLARE SUB header ()
  23. DECLARE SUB sortindex ()
  24. TYPE rectype                                'Define variables for file
  25.    pnbr AS STRING * 12
  26.    xName20 AS STRING * 30
  27.    xAddress AS STRING * 25
  28.    xcity40 AS STRING * 20
  29.    xstate50 AS STRING * 2 
  30.    xZip60 AS STRING * 10
  31.    xSpouse AS STRING * 10
  32.    xData80 AS STRING * 8 
  33.    xGift90 AS INTEGER
  34.    sts AS STRING * 1
  35. END TYPE
  36. TYPE indextype                              'Define index
  37.    recnum AS INTEGER
  38.    sort AS STRING * 30
  39. END TYPE
  40. DIM SHARED pline
  41. DIM SHARED page
  42. DIM SHARED numofrec
  43. DIM SHARED phone AS rectype
  44.  
  45. ON ERROR GOTO errhandle
  46.  
  47. OPEN "PHONE.DAT" FOR RANDOM AS #1 LEN = LEN(phone)
  48.  
  49. numofrec = LOF(1) \ LEN(phone)
  50. IF numofrec = 0 THEN
  51.    CLS
  52.    PRINT "You have to build the Data Base first."
  53.    INPUT "", a$
  54.    GOTO fina
  55. END IF
  56. DIM SHARED index(1 TO numofrec)  AS indextype
  57. FOR i = 1 TO numofrec
  58.    GET #1, i, phone
  59.    index(i).recnum = i
  60.    index(i).sort = UCASE$(phone.xName20)
  61. NEXT i
  62.  
  63. COLOR , 1
  64. CLS
  65. COLOR 4, 1
  66. LOCATE 1, 25
  67. PRINT STRING$(30, 220)
  68. LOCATE 2, 24
  69. COLOR , 0
  70. PRINT " ";
  71. COLOR 0, 3
  72. PRINT STRING$(30, " ")
  73. LOCATE 2, 31
  74. COLOR 0, 3: PRINT "Phone List by Name"
  75. LOCATE 3, 24
  76. COLOR , 0: PRINT STRING$(30, " ")
  77.  
  78. COLOR 7, 1
  79. LOCATE 5, 26
  80. PRINT "Date: "; DATE$; "    "; TIME$
  81. LOCATE 6, 26
  82. PRINT "Program name:       "; "PHONE1  "
  83. LOCATE 7, 26
  84. PRINT "Data file name:     "; "PHONE.DAT"
  85. LOCATE 8, 26
  86. PRINT "Number of records: "; numofrec
  87.  
  88. box
  89. COLOR 0, 3
  90. LOCATE 11, 26
  91. PRINT "Please check to see that the"
  92. LOCATE 12, 26
  93. PRINT "printer has paper and is "
  94. LOCATE 13, 26
  95. PRINT "on-line.  A)bort, or <ENTER>"
  96.  
  97. DO
  98. a$ = INKEY$
  99. LOOP WHILE a$ = ""
  100. IF UCASE$(a$) = "A" GOTO fina
  101.  
  102. box
  103. LOCATE 12, 27
  104. PRINT "Sorting file - Please wait"
  105. sortindex
  106. box
  107.  
  108. first$ = "F"
  109. FOR i = 1 TO numofrec
  110. IF pline <= 0 THEN
  111.    IF first$ = "" THEN LPRINT CHR$(12)
  112.    header
  113. END IF
  114. GET #1, index(i).recnum, phone
  115. IF phone.sts = "D" THEN GOTO nex
  116. LPRINT TAB(1); phone.xName20;
  117. LPRINT TAB(32); phone.pnbr;
  118. LPRINT TAB(45); phone.xcity40;
  119. LPRINT TAB(66); phone.xSpouse
  120.  
  121. a$ = INKEY$
  122. IF a$ = CHR$(27) THEN GOTO fin
  123.  
  124. first$ = ""
  125. pline = pline - 1
  126. nex:
  127. NEXT i
  128. fin:
  129.  
  130. LPRINT CHR$(12);                                'Form Feed
  131. fina:
  132. COLOR 7, 1
  133. CLS
  134. CLOSE
  135. END
  136.  
  137. errhandle:
  138. IF ERR = 25 THEN
  139.    box
  140.    LOCATE 12, 32
  141.    PRINT "Printer Not ready"
  142.    LOCATE 13, 32
  143.    PRINT "Abort or Retry "
  144.    DO
  145.       a$ = INKEY$
  146.    LOOP WHILE a$ = ""
  147.    IF UCASE$(a$) = "R" THEN
  148.       box
  149.       LOCATE 12, 32
  150.       PRINT "Printing Page:"; page
  151.       LOCATE 13, 32
  152.       PRINT "<Escape> to cancel"
  153.       RESUME
  154.    ELSE
  155.       GOTO fina
  156.    END IF
  157. ELSE
  158.    CLS
  159.    PRINT "Unexpected error number"; ERR
  160.    PRINT "Please consult your Quickbasic Manual"
  161.    INPUT "", a$
  162.    GOTO fina
  163. END IF
  164.  
  165. SUB box
  166. COLOR 4, 1
  167. LOCATE 10, 25
  168. PRINT STRING$(30, 220)
  169. COLOR 9, 7
  170. LOCATE 11, 24
  171. COLOR 0: PRINT CHR$(219); : COLOR , 3: PRINT STRING$(30, " ")'219)
  172. LOCATE 12, 24
  173. COLOR 0: PRINT CHR$(219); : COLOR , 3: PRINT STRING$(30, " ")'219)
  174. LOCATE 13, 24
  175. COLOR 0: PRINT CHR$(219); : COLOR , 3: PRINT STRING$(30, " ")'219)
  176. LOCATE 14, 24
  177. COLOR 0: PRINT STRING$(30, 219)
  178. END SUB
  179.  
  180. SUB header
  181. first$ = ""
  182. page = page + 1
  183. LOCATE 12, 32
  184. PRINT "Printing Page:"; page
  185. LOCATE 13, 31
  186. PRINT "<Escape> to cancel"
  187. IF first$ = "" THEN
  188.    first$ = "F"
  189. END IF
  190.  
  191. LPRINT TAB(2); "Run date: "; DATE$; " "; TIME$;
  192. LPRINT TAB(70); "Page:"; page
  193. LPRINT TAB(2); "Program name: PHONE1";
  194. LPRINT TAB(31); "Phone List by Name"
  195. LPRINT ""
  196.  
  197. LPRINT TAB(1); "Name";
  198. LPRINT TAB(32); "Phone";
  199. LPRINT TAB(45); "City";
  200. LPRINT TAB(66); "Spouse"
  201.  
  202. LPRINT TAB(32); "Number";
  203. LPRINT TAB(66); "Name"
  204. LPRINT STRING$(80, "=")
  205. pline = 51
  206. END SUB
  207.  
  208. SUB sortindex STATIC
  209. SHARED index() AS indextype, numofrec
  210. offset = numofrec \ 2
  211. DO WHILE offset > 0
  212.    limit = numofrec - offset
  213.    DO
  214.       switch = FALSE
  215.       FOR i = 1 TO limit
  216.          IF UCASE$(index(i).sort) > UCASE$(index(i + offset).sort) THEN
  217.             SWAP index(i), index(i + offset)
  218.             switch = i
  219.          END IF
  220.       NEXT i
  221.       limit = switch
  222.    LOOP WHILE switch
  223.    offset = offset \ 2
  224. LOOP
  225.  
  226. END SUB
  227.  
  228.